module Damas where

import Tablero
import Maybe
import Char
import Prelude
import Misc

data Juego = J Color Tablero
data Movimiento = M Posicion Direccion
  deriving (Show, Eq, Ord)

data Arbol a = Nodo a [Arbol a] deriving (Show,Eq)

raiz :: Arbol a -> a
raiz (Nodo a _) = a

hijos :: Arbol a -> [Arbol a]
hijos (Nodo _ hs) = hs

altura :: Arbol a -> Int
altura (Nodo a as) = 1 + if (null as) then 0 else maximum (map altura as)

type ArbolJugadas = Arbol ([Movimiento], Juego)

type Valuacion = Juego -> Double

---- Funciones de regalo ----

instance Show Juego where
  show (J turno tablero) = "\n--Juegan las " ++ show turno ++ "s--\n" ++ show tablero

arbolDeJugadas :: Juego -> ArbolJugadas
arbolDeJugadas j = Nodo ([], j) $ zipWith agmov movs hijos
  where agmov m (Nodo (ms, r) hs) = Nodo ((m:ms), r) (map (agmov m) hs)
        movsJuegos = movimientosPosibles j
        movs = map fst movsJuegos
        hijos = map (arbolDeJugadas . snd) movsJuegos

---- Ejercicios ----

-- Ejercicio 3
mover :: Movimiento -> Juego -> Maybe Juego
-- Si el movimiento es valido devuelve un nuevo Juego con el resultado de efectuar ese movimiento, si no, devuelve Nothing
mover (M pos dir) (J color tablero) = if esvalido then Just nuevoJuego else Nothing
	where 
		-- Se chequea la validez del movimiento, separando los casos en que se esta capturando una ficha y el que no.
		esvalido = origeninTablero && hayfichaenOrigen && fichaOrigenJuega && direccionOK && destinoInTablero
					&& (if esCaptura then destinoCapturaLibre else destinoNormalLibre)
		-- Si es una captura, el juego nuevo consiste en cambiar el color que juega y alterar el nuevo tablero.
		nuevoJuego = if not (esCaptura) 
					then J (cambiarColor color) nuevoTableroMovimientoSimple
					else J (cambiarColor color) nuevoTableroMovimientoCaptura
		-- Si es valida la posicion de origen del movimiento.
		origeninTablero = posicionValida pos
		-- Si existe una ficha en la posicion de origen del movimiento.
		hayfichaenOrigen = contenido pos tablero /= Nothing	
		-- Si coincide el color que juega con el color de la ficha contenida en el origen del movimiento.
		fichaOrigenJuega = case (contenido pos tablero) of (Just f) -> dameColor f  == color
		-- Si es correcta la direccion a donde nos queremos mover.
		direccionOK = case (contenido pos tablero) of (Just f) -> direccionCorrecta f dir
		-- Si el destino en donde va a caer la ficha existe en el tablero.
		destinoInTablero = posicionValida nuevaPosicion
		-- Si el destino donde va a caer la ficha en caso de que sea una captura esta libre. 
		destinoCapturaLibre = (contenido (nuevaPosicionCaptura pos dir) tablero) == Nothing
		-- Si el destino donde va a caer la ficha en caso de que NO sea una captura esta libre. 
		destinoNormalLibre = (contenido (nuevaPosicionSimple pos dir) tablero) == Nothing
		-- Verifica si el movimiento es una captura, viendo si la posicion adyacente en la direccion especificada es una ficha del color contrario.
		esCaptura = case (contenido (nuevaPosicionSimple pos dir) tablero) of 
																(Just f) -> dameColor f /= color
																(Nothing)-> False
		-- Devuelve la posicion a donde cae la ficha en caso de que sea una captura o que no lo sea.
		nuevaPosicion = if esCaptura then nuevaPosicionCaptura pos dir else nuevaPosicionSimple pos dir
		-- Si no es una captura, devuelve un nuevo tablero donde se removio la ficha de origen y se coloco en la posicion adyacente en la direccion de movimiento. Esta ficha nueva puede ser una reina.
		nuevoTableroMovimientoSimple = sacar pos (poner nuevaPosicion nuevaFicha tablero)
		-- Si es una captura, devuelve un nuevo tablero donde se removieron la ficha de origen y la adyacente (contraria) en en la direccion de movimiento. Ademas se coloca en la posicion correcta la nueva ficha, que puede ser una reina.
		nuevoTableroMovimientoCaptura = sacar (nuevaPosicionSimple pos dir) (sacar pos (poner nuevaPosicion nuevaFicha tablero))
		-- Si es una coronacion, la nueva ficha es una Reina, si no es una ficha simple. 
		nuevaFicha = if esCoronacion nuevaPosicion color
					then coronar (fromJust (contenido pos tablero))
					else fromJust (contenido pos tablero)

-- Verifica que la posicion pasada como parametro sea valida dentro de las coordenadas del tablero.					
posicionValida :: Posicion -> Bool
posicionValida (i,j) = j `elem` [1..8] && (ord i) `elem` [(ord 'a')..(ord 'h')]

-- Devuelve el color de una ficha.
dameColor :: Ficha -> Color
dameColor  (Simple c) = c
dameColor  (Reina c) = c

-- Verifica que la direccion del parametro sea correcta con respecto a si es una ficha simple o una reina.
direccionCorrecta :: Ficha -> Direccion -> Bool
direccionCorrecta (Reina _) _ = True
direccionCorrecta (Simple Blanca) TL = True
direccionCorrecta (Simple Blanca) TR = True
direccionCorrecta (Simple Negra) BL = True
direccionCorrecta (Simple Negra) BR = True
direccionCorrecta _ _ = False

-- Devuelve las coordenadas resultantes de un movimiento hecho por una ficha sin que se produzca una captura. 
nuevaPosicionSimple :: Posicion -> Direccion -> Posicion
nuevaPosicionSimple (i,j) TL  = (chr ((ord i)-1), j+1)
nuevaPosicionSimple (i,j) TR  = (chr ((ord i)+1), j+1)
nuevaPosicionSimple (i,j) BL  = (chr ((ord i)-1), j-1)
nuevaPosicionSimple (i,j) BR  = (chr ((ord i)+1), j-1)

-- Devuelve las coordenadas resultantes de un movimiento hecho por una ficha al producirse una captura.
nuevaPosicionCaptura :: Posicion -> Direccion -> Posicion
nuevaPosicionCaptura (i,j) TL  = (chr ((ord i)-2), j+2)
nuevaPosicionCaptura (i,j) TR  = (chr ((ord i)+2), j+2)
nuevaPosicionCaptura (i,j) BL  = (chr ((ord i)-2), j-2)
nuevaPosicionCaptura (i,j) BR  = (chr ((ord i)+2), j-2)

-- Invierte los colores
cambiarColor :: Color -> Color
cambiarColor Blanca = Negra
cambiarColor Negra = Blanca

-- Transforma una ficha Simple en Reina o si es Reina la deja como es.
coronar :: Ficha -> Ficha
coronar (Simple c) = Reina c
coronar x = x

-- Verifica, dependiendo del color de la ficha, si la nueva posicion requiere coronar.
esCoronacion :: Posicion -> Color -> Bool
esCoronacion pos c = case c of
				Negra -> snd pos == 1
				Blanca -> snd pos == 8

-- Ejercicio 4
-- Generamos todos los posibles movimientos para cada coordenada del tablero y los filtramos utilizando la funcion mover (que devuelve Nothing si un movimiento no es posible).
movimientosPosibles :: Juego -> [(Movimiento, Juego)]
movimientosPosibles juego = [ (movimiento i j d, fromJust (movida i j d)) |
											i <- ['a'..'h'],
											j <- [1..8],
											d <- [TL .. BL],
											case movida i j d of
																	Just _ -> True
																	otherwise -> False]
	where
		movida = (\i j d -> mover (movimiento i j d) juego)
		movimiento = (\i j d -> M (i, j) d)

-- Ejercicio 5
-- foldArbol :: ...

--data Arbol a = Nodo a [Arbol a] deriving Show

foldArbol :: Show a => (a-> [b] -> b) -> Arbol a -> b
foldArbol f (Nodo a as) = f a (map (foldArbol f) as)

-- Ejercicio 6
-- podar :: Int -> Arbol a -> Arbol a

-- Definiéndola recursivamente es...
-- podar' :: Arbol a -> Int -> Arbol a
-- podar' (Nodo a as) = g a (map (podar') as)
--    where g a bs = \n -> if (n == 1) then (Nodo a []) else (Nodo a (map (\f -> f (n-1)) bs))
-- Luego, es trivial transformarla a un foldArbol
podar :: Show a => Int -> Arbol a -> Arbol a
podar = flip podar'
    where g a bs = \n -> if (n == 1) then (Nodo a []) else (Nodo a (map (\f -> f (n-1)) bs))
          podar' = foldArbol g

-- Ejercicio 7
-- minimax :: Valuacion -> ArbolJugadas -> (Double, [Movimiento])

-- Podriamos escribir
-- minimax' :: ArbolJugadas -> Valuacion -> (Double, [Movimiento])
-- minimax' (Nodo (ms, juego) js) = g (ms, juego) (map minimax' js)
--    where (g (ms, juego) fs) f| null fs = (f juego, ms)
--                              | abs (f juego) == 1  = (f juego, ms)
--                             | otherwise = maximumBy cmp (map (\x -> x (neg f)) fs)
--          cmp a b = if (fst a >= fst b) then a else b
--          neg g = ((-1)*) . g
-- Escribiendo de esta forma es trivial escribir la función como un foldArbol
minimax :: Valuacion -> ArbolJugadas -> (Double, [Movimiento])
minimax = flip minimax'
    where (g (ms, juego) fs) f| null fs = (f juego, ms)
                              | abs (f juego) == 1  = (f juego, ms)
                              | otherwise = maximumBy cmp (map (\x -> x (neg f)) fs)
          cmp a b = if (fst a >= fst b) then a else b
          neg h = ((-1)*) . h
          minimax' = foldArbol g
          
mejorMovimiento :: Valuacion -> ArbolJugadas -> Movimiento
mejorMovimiento f arbol = head (snd (minimax f arbol))


--minimax f (Nodo (xs, juego)) 
-- Ejercicio 8
ganador :: Juego -> Maybe Color
ganador (J color tablero) = if length (movimientosPosibles (J color tablero)) > 0 then Nothing else Just (cambiarColor color)

-- Ejercicio 9
valuacionDamas :: Juego -> Double
valuacionDamas (J color tablero) = case ganador (J color tablero) of
												Nothing -> fromIntegral (2 * (2 * r + s)) / fromIntegral((2 * rtot + stot)) - fromIntegral 1
												Just c -> if c == color then 1 else -1
	where
		r = length ( filter (\x -> case x of {Reina c -> color == c; otherwise -> False}) listaFichas)
		s = length ( filter (\x -> case x of {Simple c -> color == c; otherwise -> False}) listaFichas)
		rtot = length ( filter (\x -> case x of {Reina _ -> True; otherwise -> False}) listaFichas)
		stot = length ( filter (\x -> case x of {Simple _ -> True; otherwise -> False}) listaFichas)
		listaFichas = [ fromJust (contenido (i, j) tablero) | i <- ['a'..'h'], j <- [1..8], case (contenido (i, j) tablero) of
																											(Just _) -> True
																											(Nothing) -> False]

-- tests

probarMover = mover (M ('c',3) TR) (J Blanca tableroInicial)
probarMover2 = mover (M ('f',6) BL) (fromJust probarMover)
probarMover3 = mover (M ('d',4) TR) (fromJust probarMover2)

